home *** CD-ROM | disk | FTP | other *** search
/ Compute! Gazette 1994 August / 1994-08b.d64 / pulsing pictures (.txt) < prev    next >
Commodore BASIC  |  2022-09-20  |  5KB  |  165 lines
  1. 0 rem    from pgms for pd # 1               taken from q-link disk # 21        .
  2. 100 rem  pulsing pictures ii for c-64
  3. 110 rem george trepal   2650 alturas rd
  4. 140 poke 52,32:poke56,32:poke650,128:dimts(39),tc(39):goto560
  5. 150 :
  6. 160 print"[147]"
  7. 170 cd=54272:h=214:l=211
  8. 180 p=1024+peek(h)*40+peek(l)+(peek(l)>39)*40
  9. 190 ch=peek(p):k=128
  10. 200 pokep,((ch+k)and255):pokep+cd,peek(646)
  11. 210 poke 53272,(peek(53272)and240)+x
  12. 220 ifz$="\"thenpoke53272,(peek(53272)and240)+4:end
  13. 230 x=x+2: if x=16 then x=8
  14. 240 getz$:ifz$=""then200
  15. 241 ifz$="[147]"thengosub1620
  16. 250 pokep,ch:printz$;
  17. 260 ifz$=chr$(34)thenpoke212,0
  18. 270 ifz$="[148]"thenpoke216,0
  19. 280 ifz$="[133]"then320
  20. 290 ifz$="[136]"then450
  21. 291 ifz$="[134]"thenpoke53280,peek(53280)-1
  22. 292 ifz$="[135]"thenpoke53281,peek(53281)-1
  23. 300 goto180
  24. 310 :
  25. 320 forj=0to39:ts(j)=peek(1024+j):tc(j)=peek(55296+j):poke(1024+j),32:next
  26. 330 input"program name";pn$
  27. 340 ifpn$=""then330
  28. 350 pn$=pn$+",s,w"
  29. 360 forj=0to39:pokej+1024,ts(j):poke(j+55296),tc(j):next
  30. 370 open8,8,8,pn$
  31. 380 gosub1580
  32. 390 forj=1024to2023:vl=peek(j):print#8,vl
  33. 400 next
  34. 410 forj=55296to56295:vl=peek(j):print#8,vl
  35. 420 next:close8:close15
  36. 430 goto170
  37. 440 :
  38. 450 input"[147]program name";pn$
  39. 460 ifpn$=""then450
  40. 470 pn$=pn$+",s,r"
  41. 480 open8,8,8,pn$
  42. 490 gosub1580
  43. 500 forj=1024to2023:input#8,vl:pokej,vl
  44. 510 next
  45. 520 forj=55296to56295:input#8,vl:pokej,vl
  46. 530 next:close8:close15
  47. 540 goto170
  48. 550 :
  49. 560 poke 53280,12: poke 53281,0: poke 646,13
  50. 570 print"[147][156]"spc(10)"pulsing pictures  ii";chr$(142)
  51. 580 print"     by george trepal and the drone"
  52. 590 printspc(6)"[152]the characters that move are:"
  53. 600 printspc(9)"unshifted 1 through 9"
  54. 610 printspc(11)"shifted 6  7  8  9"
  55. 620 printspc(6)"and unshifted ,  .  *  +  /  -"
  56. 630 print"    the [153]\ symbol exits the program."
  57. 640 printspc(6)"[153]f1 saves the screen to disk"
  58. 641 printspc(6)"[153]f3 changes the border color"
  59. 642 printspc(6)"[153]f5 changes the background color"
  60. 650 printspc(6)"[153]f7 loads a screen from disk"
  61. 660 print"[150] please wait about 1 minute for setup.."
  62. 670 printspc(9)"[154]moving character sets"
  63. 680 j=53248: k=8192: l=10240: m=12288: n=14336
  64. 690 poke56334,peek(56334)and254
  65. 700 poke 1,peek(1) and 251
  66. 710 fori=0to2023:p=peek(i+j)
  67. 720 poke i+k,p: poke i+l,p: poke i+m,p: poke i+n,p
  68. 730 next
  69. 740 poke 1,peek(1) or 4
  70. 750 poke 56334,peek(56334) or 1
  71. 760 :
  72. 770 j=8495
  73. 780 printspc(6)"[159]installing custom characters"
  74. 790 j=j+1:read x:if x<0 then810
  75. 800 poke j,x: goto790
  76. 810 if j<10000 then j=10543: goto790
  77. 820 if j<12000 then j=12591: goto790
  78. 830 if j<14000 then j=14639: goto790
  79. 840 print"[147]enter border color (0-15)";:inputsc%
  80. 841 poke53280,sc%
  81. 845 print"[147]    press  space bar [146] to continue or"
  82. 850 print"  other key to change background color"
  83. 860 geta$:ifa$=""then860
  84. 870 ifa$<>" "thenpoke53281,(cland15):cl=cl+1:goto860
  85. 880 x=8:goto160
  86. 890 data0,126,126,96,96,126,126,0,24,60
  87. 900 data102,195,129,24,60,102,24,36,66,129
  88. 910 data24,36,66,129,102,60,24,0,195,102
  89. 920 data60,24,129,66,36,24,129,66,36,24
  90. 930 data255,255,0,0,0,255,255,0,255,0
  91. 940 data0,0,255,0,0,0,255,255,0,0
  92. 950 data0,255,255,0,255,0,0,0,255,0
  93. 960 data0,0,255,129,129,129,129,129,129,255
  94. 970 data0,0,0,24,24,0,0,0,192,129
  95. 980 data3,6,12,24,48,96,3,129,192,96
  96. 990 data48,24,12,6,192,192,192,192,192,192
  97. 1000 data192,192,3,3,3,3,3,3,3,3
  98. 1010 data255,255,0,0,0,0,255,255,195,195
  99. 1020 data195,195,195,195,195,195,135,36,48,4
  100. 1030 data108,104,0,49,0,0,0,0,15,15
  101. 1040 data15,15,204,204,51,51,204,204,51,51
  102. 1050 data -1
  103. 1060 data0,126,126,102,102,102,102,0,60,102
  104. 1070 data195,129,24,60,102,195,36,66,129,24
  105. 1080 data36,66,129,24,195,102,60,24,0,195
  106. 1090 data102,60,24,129,66,36,24,129,66,36
  107. 1100 data255,0,0,0,255,255,0,0,0,0
  108. 1110 data0,255,0,0,0,255,0,255,255,0
  109. 1120 data0,0,255,255,0,255,0,0,0,255
  110. 1130 data0,0,0,126,66,66,66,66,126,0
  111. 1140 data0,0,60,36,36,60,0,0,3,6
  112. 1150 data12,24,48,96,193,131,192,96,48,24
  113. 1160 data12,6,131,193,48,48,48,48,48,48
  114. 1170 data48,48,12,12,12,12,12,12,12,12
  115. 1180 data0,255,255,0,0,255,255,0,102,102
  116. 1190 data102,102,102,102,102,102,192,196,28,80
  117. 1200 data0,103,37,32,0,0,0,0,240,240
  118. 1210 data240,240,102,102,153,153,102,102,153,153
  119. 1220 data -1
  120. 1230 data0,126,126,6,6,126,126,0,102,195
  121. 1240 data0,24,60,102,195,24,66,129,24,36
  122. 1250 data66,129,24,36,24,195,102,60,24,0
  123. 1260 data195,102,36,24,129,66,36,24,129,66
  124. 1270 data0,0,0,255,255,0,0,0,0,0
  125. 1280 data255,0,0,0,255,0,0,255,255,0
  126. 1290 data0,0,0,255,0,0,255,0,0,0
  127. 1300 data255,0,0,0,60,36,36,60,0,0
  128. 1310 data0,126,66,66,66,66,126,0,12,24
  129. 1320 data48,96,192,129,3,6,48,24,12,6
  130. 1330 data3,129,192,96,12,12,12,12,12,12
  131. 1340 data12,12,48,48,48,48,48,48,48,48
  132. 1350 data0,0,0,255,255,0,0,0,24,24
  133. 1360 data24,24,24,24,24,24,0,143,160,162
  134. 1370 data2,42,200,3,240,240,240,240,0,0
  135. 1380 data0,0,51,51,204,204,51,51,204,204
  136. 1390 data -1
  137. 1400 data0,102,102,102,102,126,126,0,195,0
  138. 1410 data24,60,102,195,24,60,129,24,36,66
  139. 1420 data129,24,36,66,60,24,195,102,60,24
  140. 1430 data0,195,66,36,152,129,66,36,24,129
  141. 1440 data0,0,255,255,0,0,0,255,0,255
  142. 1450 data0,0,0,255,0,0,0,0,255,255
  143. 1460 data0,0,0,0,0,0,0,255,0,0
  144. 1470 data0,255,0,0,0,24,24,0,0,0
  145. 1480 data255,129,129,129,129,129,129,255,48,96
  146. 1490 data192,129,3,6,12,24,12,6,3,129
  147. 1500 data192,96,48,24,3,3,3,3,3,3
  148. 1510 data3,3,192,192,192,192,192,192,192,192
  149. 1520 data0,255,255,0,0,255,255,0,54,54
  150. 1530 data54,54,54,54,54,54,3,121,0,215
  151. 1540 data16,244,6,48,15,15,15,15,0,0
  152. 1550 data0,0,102,102,153,153,102,102,153,153
  153. 1560 data -1
  154. 1570 :
  155. 1580 open15,8,15
  156. 1590 input#15,e,e$
  157. 1600 ife=0thenreturn
  158. 1610 printe,e$:close8:close15:end
  159. 1620 forj=0to39:ts(j)=peek(1024+j):tc(j)=peek(55296+j):poke(1024+j),32:next
  160. 1630 input"are you sure<y[206]n>";yn$
  161. 1640 ifyn$="y"thenz$="[147]":return
  162. 1650 ifyn$="n"then1670
  163. 1660 goto1630
  164. 1670 forj=0to39:pokej+1024,ts(j):poke(j+55296),tc(j):next:z$=chr$(0):return
  165.